home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
white.arc
/
CASE&DIS.4TH
< prev
next >
Wrap
Text File
|
1986-11-07
|
5KB
|
194 lines
\ CASE OF ENDOF ENDCASE -- fig-FORTH Decomplier 29Dec83RSW
( CASE control statement by Charles E. Eaker )
( published in FORTH Dimensions II/3 page 37 )
FORTH DEFINITIONS DECIMAL
: CASE ?COMP CSP @ SP@ CSP ! 4 ; IMMEDIATE
: OF 4 ?PAIRS
COMPILE OVER COMPILE =
COMPILE 0BRANCH HERE 0 ,
COMPILE DROP 5 ; IMMEDIATE
: ENDOF 5 ?PAIRS
COMPILE BRANCH HERE 0 ,
SWAP 2 [COMPILE] THEN 4 ; IMMEDIATE
: ENDCASE 4 ?PAIRS COMPILE DROP
BEGIN SP@ CSP @ = 0=
WHILE 2 [COMPILE] THEN REPEAT
CSP ! ; IMMEDIATE
\ fig-FORTH Decompiler -- load commands 30Dec83RSW
FORTH DEFINITIONS DECIMAL
FORGET TASK
572 576 THRU
577 LOAD BEEP ." DIS decompiler ready " CR
EXIT
\ constants -- fig-FORTH Decompiler 30Dec83RSW
FORTH DEFINITIONS DECIMAL : TASK ;
0 VARIABLE QUIT.FLAG 0 VARIABLE WORD.PTR
( find run-time address of each vocabulary word type )
' <LOOP> 2 - CONSTANT LOOP.ADR
' LIT 2 - CONSTANT LIT.ADR
' : 2 - @ CONSTANT DOCOL.ADR
' 0BRANCH 2 - CONSTANT 0BRANCH.ADR
' BRANCH 2 - CONSTANT BRANCH.ADR
' <+LOOP> 2 - CONSTANT PLOOP.ADR
' <."> 2 - CONSTANT PDOTQ.ADR
' C/L 2 - @ CONSTANT CONST.ADR
' BASE 2 - @ CONSTANT USERV.ADR
' USE 2 - @ CONSTANT VAR.ADR
' <;CODE> 2 - CONSTANT PSCODE.ADR
\ constants cont -- fig-FORTH Decompiler 30Dec83RSW
' </LOOP> 2 - CONSTANT SLOOP.ADR
' <ABORT"> 2 - CONSTANT PABORTQ.ADR
' EXIT 2 - CONSTANT EXIT.ADR
\ N. PDOTQ.DSP WORD.DSP -- fig-FORTH Decompiler 30Dec83RSW
FORTH DEFINITIONS DECIMAL
: N. ( print a number in decimal and hex )
DUP DECIMAL . SPACE
HEX 0 ." ( " D. ." H ) " DECIMAL ;
: PDOTQ.DSP ( display a compiled text string )
WORD.PTR @ 2+ DUP >R DUP
C@ + 1 - WORD.PTR !
R> COUNT TYPE ;
: WORD.DSP ( given CFA, display the glossary name )
3 - -1 TRAVERSE DUP 1+ C@ 59 =
IF 1 QUIT.FLAG ! THEN
DUP C@ 160 AND 128 =
IF ID. ELSE 1 QUIT.FLAG ! THEN ;
\ BRANCH.DSP USERV.DSP -- fig-FORTH Decompiler 30Dec83RSW
: BRANCH.DSP ( get branch offset, calculate the )
( actual branch address, and display it )
." to "
WORD.PTR @ 2+ DUP WORD.PTR !
DUP @ +
0 HEX D. DECIMAL ;
: USERV.DSP ( display a user variable )
." User variable, current value = "
WORD.PTR @ 2+
C@ [ HEX ] 38 UP @ + + [ DECIMAL ]
@ N.
1 QUIT.FLAG ! ;
\ VAR.DSP CONST.DSP -- fig-FORTH Decompiler 30Dec83RSW
: VAR.DSP ( display a variable )
." Variable, current value = "
WORD.PTR @ 2+
@ N.
1 QUIT.FLAG ! ;
: CONST.DSP ( display a compiled constant )
." Constant, value = "
WORD.PTR @ 2+
@ N.
1 QUIT.FLAG ! ;
\ DIS -- fig-FORTH Decompiler 29Dec83RSW
: DIS
-FIND 0=
IF 3 SPACES ." ? not in glossary " CR
ELSE DROP DUP DUP 2 -
@ =
IF ." <primitive> " CR
ELSE
0 QUIT.FLAG !
2 - WORD.PTR !
CR CR
BEGIN
WORD.PTR @ DUP
0 HEX D. SPACE DECIMAL
@
-->
\ DIS cont -- fig-FORTH Decompiler 30Dec83RSW
CASE
LIT.ADR OF
WORD.PTR @ 2+ DUP WORD.PTR ! @ N. ENDOF
DOCOL.ADR OF
." : " ENDOF
0BRANCH.ADR OF
." Branch if zero " BRANCH.DSP ENDOF
BRANCH.ADR OF
." Branch " BRANCH.DSP ENDOF
LOOP.ADR OF
." Loop " BRANCH.DSP ENDOF
PLOOP.ADR OF
." +Loop " BRANCH.DSP ENDOF
SLOOP.ADR OF
." /Loop " BRANCH.DSP ENDOF -->
\ DIS cont -- fig-FORTH Decompiler 30Dec83RSW
PDOTQ.ADR OF
." Print text: " PDOTQ.DSP ENDOF
PABORTQ.ADR OF
." Abort text: " PDOTQ.DSP ENDOF
USERV.ADR OF
USERV.DSP ENDOF
VAR.ADR OF
VAR.DSP ENDOF
CONST.ADR OF
CONST.DSP ENDOF
PSCODE.ADR OF
WORD.PTR @ @ WORD.DSP
1 QUIT.FLAG ! ENDOF
EXIT.ADR OF
." Exit " 1 QUIT.FLAG ! ENDOF -->
\ DIS cont -- fig-FORTH Decompiler 30Dec83RSW
DUP WORD.DSP
ENDCASE CR
2 WORD.PTR +!
QUIT.FLAG @
?TERMINAL OR
UNTIL
THEN THEN CR ; ( all done now )
EXIT
QUIT.FLAG @
?T